TOP
Fuzzy Lookup pour LibreOffice Calc
FUZZYLOOKUP() descriptif
Nous connaissons tous la fonction bien connue VLOOKUP() qui nous aide à combiner les données de différentes tables. Cependant, cette fonction présente un inconvénient important : elle ne peut pas combiner des valeurs similaires, c'est-à-dire que s'il y a une erreur dans le mot, il n'y aura pas de correspondance.
Pour pouvoir combiner des valeurs approximatives, nous pouvons créer notre propre fonction. Appelons-le FuzzyLookup().
Imaginons que nous ayons deux listes. Les deux contiennent à peu près les mêmes éléments, mais ils peuvent être écrits légèrement différemment. La tâche consiste à trouver pour chaque élément de la première liste l'élément le plus similaire de la deuxième liste, c'est-à-dire implémenter une recherche du texte le plus proche le plus similaire.
La grande question, dans ce cas, est de savoir ce qu’il faut considérer comme critère de « similarité ». Juste le nombre de caractères correspondants ? Est-ce que le nombre de matchs consécutifs ? La casse des caractères ou les espaces doivent-ils être pris en compte ? Que faire avec une disposition différente des mots dans une phrase ? Il existe de nombreuses options et il n’existe pas de solution unique : pour chaque situation, l’une ou l’autre sera meilleure que les autres.
Dans notre cas, nous implémentons l'option la plus simple : rechercher par le nombre maximum de correspondances de caractères. Ce n'est pas parfait, mais cela fonctionne plutôt bien dans la plupart des situations.
Code StarBASIC pour la fonction FuzzyLookup
Ajouter fonction FuzzyLookup , ouvrez le menu Tools - Macros - Edit Macros... , sélectionner Module1 et copiez le texte suivant dans le module :
- Function FuzzyLOOKUP(LookupValue As String, SrcTable As Variant, Optional SimThreshold As Single) As String
-
- Dim Str As String
- Dim CellArray As Variant
- Dim StrArray As Variant
-
- If IsMissing(SimThreshold) Then SimThreshold = 0
-
- Str = LCase(LookupValue)
- StrArray = Split(Str)
- StrExt = UBound(StrArray)
-
- For Each Cell In SrcTable
-
- CellArray = Split(LCase(Cell))
- CellExt = UBound(CellArray)
- CellRate = 0
-
-
- For x = 0 To StrExt
-
- StrWord = StrArray(x)
- If Len(StrWord) = 0 Then GoTo continue_x
- MaxStrWordRate = 0
-
-
- For i = 0 To CellExt
-
- CellWord = CellArray(i)
- If Len(CellWord) = 0 Then GoTo continue_i
-
- FindCharNum = OccurrenceNum(StrWord, CellWord)
- StrWordRate = FindCharNum / Max(Len(StrWord),Len(CellWord))
-
- If StrWordRate > MaxStrWordRate Then MaxStrWordRate = StrWordRate
- continue_i:
- Next i
-
- CellRate = CellRate + MaxStrWordRate
- continue_x:
- Next x
-
-
- If CellRate > MaxCellRate Then
- MaxCellRate = CellRate
- BestCell = Cell
-
- FindCharNum = OccurrenceNum(Str, Cell)
- SimRate = FindCharNum / Max(Len(Str),Len(Cell))
- End If
-
- Next Cell
-
- IF SimRate >= SimThreshold Then
- IF SimThreshold = -1 Then
- ReturnValue = BestCell + " (" + Format(SimRate, "0.00") + ")"
- ElseIf SimThreshold = -2 Then
- ReturnValue = Format(SimRate, "0.00")
- Else
- ReturnValue = BestCell
- End If
- Else
- ReturnValue = ""
- End If
-
- FuzzyLOOKUP = ReturnValue
- End Function
-
-
- Function OccurrenceNum(ByVal SourceString As String, ByVal TargetString As String)
- For i = 1 To Len(SourceString)
-
- Position = InStr(1, TargetString, Mid(SourceString, i, 1), 1)
-
- If Position > 0 Then
- Count = Count + 1
-
- TargetString = Left(TargetString, Position - 1) + Right(TargetString, Len(TargetString) - Position)
- End If
- Next i
- OccurrenceNum = Count
- End Function
-
-
- Function Max(ByVal value1 As Variant, ByVal value2 As Variant)
- If value1 > value2 Then
- Result = value1
- Else
- Result = value2
- End If
- Max = Result
- End Function
Function FuzzyLOOKUP(LookupValue As String, SrcTable As Variant, Optional SimThreshold As Single) As String
' moonexcel.com.ua
Dim Str As String
Dim CellArray As Variant
Dim StrArray As Variant
If IsMissing(SimThreshold) Then SimThreshold = 0
Str = LCase(LookupValue)
StrArray = Split(Str)
StrExt = UBound(StrArray)
For Each Cell In SrcTable
CellArray = Split(LCase(Cell))
CellExt = UBound(CellArray)
CellRate = 0
' Nous vérifions chaque mot dans la phrase de recherche
For x = 0 To StrExt
StrWord = StrArray(x)
If Len(StrWord) = 0 Then GoTo continue_x
MaxStrWordRate = 0
' Nous vérifions chaque mot dans la cellule suivante du tableau de valeurs d'origine
For i = 0 To CellExt
CellWord = CellArray(i)
If Len(CellWord) = 0 Then GoTo continue_i
FindCharNum = OccurrenceNum(StrWord, CellWord)
StrWordRate = FindCharNum / Max(Len(StrWord),Len(CellWord))
If StrWordRate > MaxStrWordRate Then MaxStrWordRate = StrWordRate
continue_i:
Next i
CellRate = CellRate + MaxStrWordRate
continue_x:
Next x
' On garde le meilleur match
If CellRate > MaxCellRate Then
MaxCellRate = CellRate
BestCell = Cell
FindCharNum = OccurrenceNum(Str, Cell)
SimRate = FindCharNum / Max(Len(Str),Len(Cell))
End If
Next Cell
IF SimRate >= SimThreshold Then
IF SimThreshold = -1 Then
ReturnValue = BestCell + " (" + Format(SimRate, "0.00") + ")"
ElseIf SimThreshold = -2 Then
ReturnValue = Format(SimRate, "0.00")
Else
ReturnValue = BestCell
End If
Else
ReturnValue = ""
End If
FuzzyLOOKUP = ReturnValue
End Function
Function OccurrenceNum(ByVal SourceString As String, ByVal TargetString As String)
For i = 1 To Len(SourceString)
' Nous recherchons l'occurrence de chaque symbole
Position = InStr(1, TargetString, Mid(SourceString, i, 1), 1)
' On augmente le compteur des coïncidences
If Position > 0 Then
Count = Count + 1
' Supprimer le symbole trouvé
TargetString = Left(TargetString, Position - 1) + Right(TargetString, Len(TargetString) - Position)
End If
Next i
OccurrenceNum = Count
End Function
Function Max(ByVal value1 As Variant, ByVal value2 As Variant)
If value1 > value2 Then
Result = value1
Else
Result = value2
End If
Max = Result
End Function
Ensuite, fermez Macro Editor et retour à la feuille de travail LibreOffice Calc - vous pouvez maintenant utiliser notre nouvelle fonctionnalité FuzzyLookup() .
Utiliser l'extension
Vous pouvez également utiliser la fonctionnalité FUZZYLOOKUP() en installant l'extension gratuite YouLibreCalc.oxt ou sa version complète YLC_Utilities.oxt .
Après cela, cette fonction sera disponible dans tous les fichiers qui seront ouverts dans LibreOffice Calc.